home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / pibasync.arc / FIXBRACK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-10-31  |  6.5 KB  |  174 lines
  1. (*$C-,U-,R-,V-,K-*)
  2. PROGRAM FixBrack;
  3.  
  4. (*--------------------------------------------------------------------------*)
  5. (*                                                                          *)
  6. (*    Program:  FixBrack                                                    *)
  7. (*                                                                          *)
  8. (*    Purpose:  Neatens output of Dave Baldwin's INLINE assembler for       *)
  9. (*              Turbo Pascal so that the code is lined up properly.         *)
  10. (*                                                                          *)
  11. (*    Usage:    Compile and run in the usual way.  You will be prompted     *)
  12. (*              for the input and output file names.                        *)
  13. (*                                                                          *)
  14. (*--------------------------------------------------------------------------*)
  15.  
  16. TYPE
  17.    AnyStr      = STRING[255];
  18.    NameStr     = STRING[40];
  19.    Text_File   = TEXT[4096];
  20.  
  21. VAR
  22.    OldObjFile  : Text_File;
  23.    OldObjName  : NameStr;
  24.    NewObjFile  : Text_File;
  25.    NewObjName  : NameStr;
  26.  
  27. (*--------------------------------------------------------------------------*)
  28. (*                     Dupl -- Duplicate a character n times                *)
  29. (*--------------------------------------------------------------------------*)
  30.  
  31. FUNCTION Dupl( Dup_char : Char; Dup_Count: INTEGER ) : AnyStr;
  32.  
  33. (*--------------------------------------------------------------------------*)
  34. (*                                                                          *)
  35. (*    Function: Dupl                                                        *)
  36. (*                                                                          *)
  37. (*    Purpose:  Duplicate a character n times                               *)
  38. (*                                                                          *)
  39. (*    Calling Sequence:                                                     *)
  40. (*                                                                          *)
  41. (*       Dup_String := Dupl( Dup_Char: Char; Dup_Count: INTEGER ): AnyStr;  *)
  42. (*                                                                          *)
  43. (*          Dup_Char   --- Character to be duplicated                       *)
  44. (*          Dup_Count  --- Number of times to duplicate character           *)
  45. (*          Dup_String --- Resultant duplicated string                      *)
  46. (*                                                                          *)
  47. (*          Note:  If Dup_Count <= 0, a null string is returned.            *)
  48. (*                                                                          *)
  49. (*    Calls:  None                                                          *)
  50. (*                                                                          *)
  51. (*                                                                          *)
  52. (*    Remarks:                                                              *)
  53. (*                                                                          *)
  54. (*       This routine could be programmed directly in Turbo as:             *)
  55. (*                                                                          *)
  56. (*          VAR                                                             *)
  57. (*             S    : AnyStr;                                               *)
  58. (*                                                                          *)
  59. (*          BEGIN                                                           *)
  60. (*                                                                          *)
  61. (*             FillChar( S[1], Dup_Count, Dup_Char );                       *)
  62. (*             S[0] := CHR( Dup_Count );                                    *)
  63. (*                                                                          *)
  64. (*             Dupl := S;                                                   *)
  65. (*                                                                          *)
  66. (*          END;                                                            *)
  67. (*                                                                          *)
  68. (*--------------------------------------------------------------------------*)
  69.  
  70. BEGIN (* Dupl *)
  71.  
  72.    INLINE(  $16/                   (* PUSH      SS         ; Push stack ptr        *)
  73.             $07/                   (* POP       ES         ; For result addressing *)
  74.             $8B/$4E/$04/           (* MOV       CX,[BP+4]  ; Pick up dup count     *)
  75.             $88/$4E/$08/           (* MOV       [BP+8],CL  ; Store result length   *)
  76.             $8B/$46/$06/           (* MOV       AX,[BP+6]  ; Get char to duplicate *)
  77.             $8D/$7E/$09/           (* LEA       DI,[BP+9]  ; Result address        *)
  78.             $FC/                   (* CLD                  ; Set direction flag    *)
  79.             $F3/$AA                (* REPLSTOSB            ; Perform duplication   *)
  80.          );
  81.  
  82. END   (* Dupl *);
  83.  
  84. PROCEDURE Process_Files;
  85.  
  86. VAR
  87.    S       : AnyStr;
  88.    L       : INTEGER;
  89.    I       : INTEGER;
  90.    MaxBrack: INTEGER;
  91.  
  92. BEGIN (* Process_Filess *)
  93.  
  94.    ASSIGN( OldObjFile, OldObjName );
  95.    RESET ( OldObjFile );
  96.  
  97.    ASSIGN ( NewObjFile, NewObjName );
  98.    REWRITE( NewObjFile );
  99.  
  100.    WRITELN('Modifying ',OldObjName);
  101.  
  102.    MaxBrack := 0;
  103.  
  104.    REPEAT
  105.  
  106.       READLN( OldObjFile, S );
  107.  
  108.       I := POS( '{' , S );
  109.  
  110.       IF ( I > MaxBrack ) THEN
  111.          MaxBrack := I;
  112.  
  113.    UNTIL ( EOF( OldObjFile ) );
  114.  
  115.    RESET( OldObjFile );
  116.  
  117.    REPEAT
  118.  
  119.       READLN( OldObjFile, S );
  120.  
  121.       I := POS( '{' , S );
  122.  
  123.       IF ( I > MaxBrack ) THEN
  124.          MaxBrack := I;
  125.  
  126.       IF ( I = 0 ) THEN
  127.          WRITELN( NewObjFile , S )
  128.       ELSE
  129.          BEGIN
  130.             L := LENGTH( S );
  131.             WRITELN( NewObjFile, COPY( S, 1, I - 1 ),
  132.                      DUPL( ' ' , MaxBrack - I ), COPY( S, I, L - I + 1 ) );
  133.          END;
  134.  
  135.    UNTIL ( EOF( OldObjFile ) );
  136.  
  137.    CLOSE( OldObjFile );
  138.  
  139.    WRITELN;
  140.  
  141.    CLOSE( NewObjFile );
  142.  
  143. END   (* Process_Filess *);
  144.  
  145. PROCEDURE Get_File_Names;
  146.  
  147. BEGIN (* Get_File_Names *)
  148.  
  149.    IF ParamCount > 0 THEN
  150.       OldObjName := ParamStr( 1 )
  151.    ELSE
  152.       BEGIN
  153.          WRITE('File to read:  ');
  154.          READLN( OldObjName );
  155.       END;
  156.  
  157.    IF ParamCount > 1 THEN
  158.       NewObjName := ParamStr( 2 )
  159.    ELSE
  160.       BEGIN
  161.          WRITE('File to write: ');
  162.          READLN( NewObjName );
  163.       END;
  164.  
  165. END   (* Get_File_Names *);
  166.  
  167. BEGIN (* FixBrack *)
  168.  
  169.    Get_File_Names;
  170.  
  171.    Process_Files;
  172.  
  173. END   (* FixBrack *).
  174.